home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbsrt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  16.1 KB  |  426 lines
  1. (*===========================================================================*)
  2. (* Procedure to send/receive things to the tnc                               *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$DEFINE POINT_CHK}
  10. {$DEFINE FREE_CHK}
  11.  
  12. {$UNDEF DEBUG_BLOCK}
  13. {$UNDEF DEBUG}
  14. {$DEFINE DEBUG_SRTQ} (* Turns trace on in SRTQ *)
  15.  
  16. UNIT BBSRT;
  17.  
  18. INTERFACE
  19.  
  20.   PROCEDURE send_recv_tnc(tnc_cmd_data : BYTE);
  21.   FUNCTION  garbage_collect_tnc : STRING;
  22.   FUNCTION  pending_chain(type_to_check : BYTE) : BYTE;
  23.   PROCEDURE set_port_speed(speed : WORD);
  24.   FUNCTION  test_phone_connect : BOOLEAN;
  25.  
  26. IMPLEMENTATION
  27.  
  28. USES
  29.   CRT,
  30.   DOS,
  31.   bbdummy,
  32.   bbdump,
  33.   bblstr,
  34.   bbmisc3,
  35.   bbsess,
  36.   bbsema2,
  37.   bbsrtbpq,
  38.   bbstack,
  39.   bbstr,
  40.   bbtask,
  41.   bbtime,
  42.   bbtrace,
  43.   bbwin;
  44.  
  45. (*===========================================================================*)
  46. (* Get ASYNC Constants                                                       *)
  47. (*===========================================================================*)
  48.  
  49. {$I 8250CON.PAS}
  50.  
  51. (*===========================================================================*)
  52. (* Subroutines                                                               *)
  53. (*===========================================================================*)
  54.  
  55. {$I BBSRTSEM.PAS}                 (* Semaphore                               *)
  56. {$I BBSRTGAR.PAS}                 (* Garbage collector                       *)
  57. {$I BBSRTPEN.PAS}                 (* Pending chain subroutines               *)
  58. {$I BBSRTM.PAS}                   (* Miscellaneous                           *)
  59.  
  60. (*===========================================================================*)
  61. (* Procedure to send/receive things to the tnc                               *)
  62. (*    Parm = 0 -- Data                                                       *)
  63. (*           1 -- Command                                                    *)
  64. (*           2 -- General Poll                                               *)
  65. (*           3 -- Data Poll                                                  *)
  66. (*           4 -- Link Status Poll                                           *)
  67. (*           5 -- Issue JHOST1                                               *)
  68. (*           6 -- Force JHOST1                                               *)
  69. (*===========================================================================*)
  70.  
  71. VAR
  72.   master_thread  : BOOLEAN;
  73.   time_out_value : WORD;
  74.  
  75. PROCEDURE send_recv_tnc(tnc_cmd_data : BYTE);
  76.  
  77.   (*-------------------------------------------------------------------------*)
  78.   (* Local variables                                                         *)
  79.   (*-------------------------------------------------------------------------*)
  80.  
  81.   VAR
  82.     busy_char      : ^CHAR;
  83.     i              : WORD;
  84.     overlay_string : ^STRING;
  85.     p_type         : port_type_type;
  86.     tnc_registers  : REGISTERS;
  87.  
  88.   LABEL
  89.     busy_loop;
  90.  
  91.   (*-------------------------------------------------------------------------*)
  92.   (* Controls for the QRES handler.                                          *)
  93.   (*-------------------------------------------------------------------------*)
  94.  
  95.   VAR
  96.     qres1_switch    : BOOLEAN;             (* First Pass for QRES            *)
  97.     qres2_switch    : BOOLEAN;             (* Second Pass for QRES           *)
  98.     qres_loop       : BOOLEAN;             (* Loop caused by QRES            *)
  99.     qres_resp       : BOOLEAN;             (* Response mode for QRES         *)
  100.  
  101.   (*-------------------------------------------------------------------------*)
  102.   (* Subroutines                                                             *)
  103.   (*-------------------------------------------------------------------------*)
  104.  
  105.   {$I BBSRTQ.PAS}                 (* Queueing subroutines                    *)
  106.   {XX BBSRTBYT.PAS}               (* Byte mode I/O routines -- External TNC  *)
  107.   {$I BBSRTBLO.PAS}               (* Block mode I/O routines - External TNC  *)
  108.   {$I BBSRTPCP.PAS}               (* PC*PA I/O routines                      *)
  109.   {$I BBSRT232.PAS}               (* PK-232 I/O routines                     *)
  110.   {$I BBSRTMOD.PAS}               (* Telephone Modem                         *)
  111.  
  112.   BEGIN;
  113.  
  114.     (*-----------------------------------------------------------------------*)
  115.     (* Show master thread                                                    *)
  116.     (*-----------------------------------------------------------------------*)
  117.  
  118.     master_thread := active_tcb^.tcb_type = th_main;
  119.  
  120.     (*-----------------------------------------------------------------------*)
  121.     (* Set timeout value                                                     *)
  122.     (*-----------------------------------------------------------------------*)
  123.  
  124.     IF opt_block.opt_extend_timeout THEN
  125.       time_out_value := 80 * up_ticks_per_sec
  126.     ELSE
  127.       time_out_value := 20 * up_ticks_per_sec;
  128.  
  129.     (*-----------------------------------------------------------------------*)
  130.     (* Checkout                                                              *)
  131.     (*-----------------------------------------------------------------------*)
  132.  
  133.     {$IFDEF POINT_CHK}
  134.       test_pointer(active_tcb^.tnc_htt);
  135.       test_pointer(active_tcb^.tnc_tth);
  136.     {$ENDIF}
  137.  
  138.     (*-----------------------------------------------------------------------*)
  139.     (* Go to other routines                                                  *)
  140.     (*-----------------------------------------------------------------------*)
  141.  
  142.     p_type := active_port^.port_type;
  143.  
  144.     CASE p_type OF
  145.  
  146.       port_bpqhost:
  147.         BEGIN;
  148.           send_recv_tnc_BPQ(tnc_cmd_data);
  149.           EXIT;
  150.         END;
  151.  
  152.       port_g8bpq, port_aeapk232:
  153.         BEGIN;
  154.           send_recv_232(tnc_cmd_data);
  155.           EXIT;
  156.         END;
  157.  
  158.       port_modem:
  159.         BEGIN;
  160.           send_recv_modem(tnc_cmd_data);
  161.           EXIT;
  162.         END;
  163.  
  164.       ELSE;
  165.     END;
  166.  
  167.     (*-----------------------------------------------------------------------*)
  168.     (* Set the QRES switch as needed.  QRES is a very special command to the *)
  169.     (* TNC that tells it to do a restart.  This will cause us to loose       *)
  170.     (* host mode so we must force it back into host mode.                    *)
  171.     (*-----------------------------------------------------------------------*)
  172.  
  173.     WITH active_tcb^.tnc_data DO
  174.       IF (str_data = 'QRES') AND (tnc_cmd_data = info_cmd_cmd) THEN               (* Transmission is command              *)
  175.         qres1_switch := TRUE
  176.       ELSE
  177.         qres1_switch := FALSE;
  178.  
  179.     qres2_switch := FALSE;
  180.     qres_loop    := FALSE;
  181.     qres_resp    := qres1_switch;
  182.  
  183.     (*-----------------------------------------------------------------------*)
  184.     (* Initialize some variables                                             *)
  185.     (*-----------------------------------------------------------------------*)
  186.  
  187.     overlay_string := @active_tcb^.tnc_tth^.tnc_code;
  188.  
  189.     (*-----------------------------------------------------------------------*)
  190.     (* This is where we loop to on a TNC busy                                *)
  191.     (*-----------------------------------------------------------------------*)
  192.  
  193. busy_loop:
  194.  
  195.     (*-----------------------------------------------------------------------*)
  196.     (* Prevent execution if requested                                        *)
  197.     (*-----------------------------------------------------------------------*)
  198.  
  199.     WHILE active_tcb^.tcb_stop_tnc_io DO
  200.       task_switch;
  201.  
  202.     (*-----------------------------------------------------------------------*)
  203.     (* See if special poll code                                              *)
  204.     (*-----------------------------------------------------------------------*)
  205.  
  206.     IF tnc_cmd_data > 1 THEN
  207.       WITH active_tcb^ DO
  208.         BEGIN;
  209.  
  210.           CASE tnc_cmd_data OF
  211.             2: tnc_data.str_data    := 'G';
  212.             3: tnc_data.str_data    := 'G0';
  213.             4: tnc_data.str_data    := 'G1';
  214.             5: tnc_data.str_data    := 'JHOST1';
  215.             6: tnc_data.str_data    := ^I^Q^X^['JHOST1'^M;
  216.           END;
  217.  
  218.           tnc_cmd_data := info_cmd_cmd;
  219.  
  220.           tnc_data.long_length := LENGTH(tnc_data.str_data);
  221.  
  222.         END;
  223.  
  224.     (*-----------------------------------------------------------------------*)
  225.     (* Move the data to be sent into the TNC buffer                          *)
  226.     (*-----------------------------------------------------------------------*)
  227.  
  228.     WITH active_tcb^, active_tcb^.tnc_htt^ DO
  229.       BEGIN;
  230.  
  231.         tnc_htt^.channel  := active_tcb^.channel;
  232.         info_cmd          := tnc_cmd_data;
  233.         i                 := tnc_data.long_length;
  234.  
  235.         IF (i = 0) OR (i > 256) THEN
  236.           BEGIN;
  237.             WRITELN(i ,' len rcvd', '-',
  238.                            LENGTH(tnc_data.str_data), '-', tnc_data.str_data);
  239.             WRITELN(info_cmd);
  240.             WRITELN('LL=', tnc_data.long_length,
  241.                     '-LD=', tnc_data.long_data[1]);
  242.           END;
  243.  
  244.         data_count := i - 1;
  245.         MOVE(tnc_data.long_data[1], data[1], i);
  246.  
  247.       END;
  248.  
  249.     (*-----------------------------------------------------------------------*)
  250.     (* Execute I/O in the correct manor                                      *)
  251.     (*-----------------------------------------------------------------------*)
  252.  
  253.     WITH active_port^, active_tcb^ DO
  254.       IF p_type = port_pc1xx THEN
  255.         BEGIN;
  256.  
  257.           (*-----------------------------------------------------------------*)
  258.           (* Handle the PC-1XX cards                                         *)
  259.           (*-----------------------------------------------------------------*)
  260.  
  261.           WITH tnc_registers DO
  262.             BEGIN;
  263.               AX := $0A00;
  264.               DX := com_number - 1;
  265.               DI := OFS(tnc_htt^);
  266.               ES := SEG(tnc_htt^);
  267.             END;
  268.  
  269.           INTR(tnc_interrupt, tnc_registers);
  270.         END
  271.       ELSE
  272.         WITH active_port^ DO
  273.           BEGIN;
  274.  
  275.             (*---------------------------------------------------------------*)
  276.             (* Handle all other cards                                        *)
  277.             (*---------------------------------------------------------------*)
  278.  
  279.             (*---------------------------------------------------------------*)
  280.             (* If we are not looping on a QRES then issue the locks          *)
  281.             (*---------------------------------------------------------------*)
  282.  
  283.             IF NOT qres_loop THEN
  284.               BEGIN;
  285.                 get_port_semaphore;
  286.                 task_switch;
  287.               END;
  288.  
  289.             (*---------------------------------------------------------------*)
  290.             (* Send in BLOCK or PC*PA mode                                   *)
  291.             (*---------------------------------------------------------------*)
  292.  
  293.             CASE p_type OF
  294.               port_pcpa : send_pcpa_mode;
  295.               ELSE
  296.                 send_block_mode;
  297.             END;
  298.  
  299.             (*---------------------------------------------------------------*)
  300.             (* If we are in the QRES loop, need special garbage collect      *)
  301.             (*---------------------------------------------------------------*)
  302.  
  303.             IF qres_resp THEN
  304.               BEGIN;
  305.                 IF qres1_switch THEN
  306.                   window_write('', 'QRES responses');
  307.                 i := 0;
  308.                 WHILE i < 800 DO
  309.                   BEGIN;
  310.                     INC(i);
  311.                     task_switch;
  312.                     overlay_string^ := garbage_collect_tnc;
  313.                     IF LENGTH(overlay_string^) <> 0 THEN
  314.                       BEGIN;
  315.                         window_write('', overlay_string^);
  316.                         i := 0;
  317.                       END;
  318.                   END;
  319.               END;
  320.  
  321.             (*---------------------------------------------------------------*)
  322.             (* If we just sent a QRES, set up for the JHOST1                 *)
  323.             (*---------------------------------------------------------------*)
  324.  
  325.             IF qres1_switch THEN
  326.               BEGIN;
  327.                 qres1_switch := FALSE;
  328.                 qres2_switch := TRUE;
  329.                 qres_loop    := TRUE;
  330.                 tnc_cmd_data := 6;
  331.                 GOTO busy_loop;
  332.               END;
  333.  
  334.             (*---------------------------------------------------------------*)
  335.             (* Second time thru for the QRES?  If so we just did a JHOST1    *)
  336.             (* so lets repeat it to confirm the mode                         *)
  337.             (*---------------------------------------------------------------*)
  338.  
  339.             IF qres2_switch THEN
  340.               BEGIN;
  341.                 qres2_switch := FALSE;
  342.                 qres_resp    := FALSE;
  343.                 tnc_cmd_data := 5;
  344.                 GOTO busy_loop;
  345.               END;
  346.  
  347.             (*---------------------------------------------------------------*)
  348.             (* Free locks and let someone else run                           *)
  349.             (*---------------------------------------------------------------*)
  350.  
  351.             free_port_semaphore;
  352.  
  353.             task_switch;
  354.           END;
  355.  
  356.     (*-----------------------------------------------------------------------*)
  357.     (* Special check for TNC busy                                            *)
  358.     (*-----------------------------------------------------------------------*)
  359.  
  360.     WITH active_tcb^.tnc_tth^ DO
  361.       IF tnc_code = t_to_h_badmsg THEN
  362.         BEGIN;
  363.           i := 1;
  364.           WHILE (i < SIZEOF(t_to_h_busy)) AND (data15[i] = t_to_h_busy[i]) DO
  365.             INC(i);
  366.           IF i >= SIZEOF(t_to_h_busy) THEN
  367.             BEGIN;
  368.               window_write_critical('Busy TNC received -- ',
  369.                                                        active_port^.port_char);
  370.               FOR i := 1 TO 50 DO
  371.                 task_switch;
  372.               GOTO busy_loop;
  373.             END;
  374.         END;
  375.  
  376.     (*-----------------------------------------------------------------------*)
  377.     (* Move data from TNC buffer into data buffer                            *)
  378.     (*-----------------------------------------------------------------------*)
  379.  
  380.     WITH active_tcb^, active_tcb^.tnc_tth^ DO
  381.       BEGIN;
  382.  
  383.         tnc_type  := tnc_code;
  384.         CASE tnc_type OF
  385.           0   : BEGIN;
  386.                   tnc_data.long_length := 0;
  387.                   tnc_data.str_data    := '';
  388.                 END;
  389.  
  390.           1..5: BEGIN;
  391.                   overlay_string^[0] := CHR(255);
  392.                   i := POS(CHR(0), overlay_string^);
  393.                   IF i = 0 THEN
  394.                     i := 255;
  395.                   overlay_string^[0] := CHR(i-1);
  396.                   l_move_str(@tnc_data, overlay_string^);
  397.                 END;
  398.  
  399.           6..7: BEGIN;
  400.                   i := data67_count + 1;
  401.                   tnc_data.long_length := i;
  402.                   MOVE(data67, tnc_data.long_data, i);
  403.                   IF i > 255 THEN
  404.                     i := 255;
  405.                   tnc_data.str_data[0] := CHR(i);
  406.                 END;
  407.           ELSE
  408.             window_write_critical_i('Unknown response code from TNC -- '
  409.                                                     + active_port^.port_char
  410.                                                     + ' -- ',
  411.                                      tnc_type);
  412.         END;
  413.  
  414.       END;
  415.  
  416.     (*-----------------------------------------------------------------------*)
  417.     (* Set null response if appropriate                                      *)
  418.     (*-----------------------------------------------------------------------*)
  419.  
  420.     WITH active_tcb^ DO
  421.       tnc_null := tnc_data.long_length = 0;
  422.  
  423.   END; (*----- End main send/receive TNC ------------------------------------*)
  424.  
  425. END.
  426.